home *** CD-ROM | disk | FTP | other *** search
/ PC User 2003 May / Disc 1 / PCU0503CD1.iso / magstuff / program / files / quest312.exe / {app} / standard.lib < prev    next >
Encoding:
Text File  |  2000-08-23  |  16.8 KB  |  579 lines
  1. !library
  2.  
  3. '----------------------------------------------------------------------
  4.  
  5. 'Filename:    standard.lib
  6.  
  7. 'Version:        beta 3a ( minor bug fix of beta 3 )
  8.  
  9. 'Type:        ASL Library ( for Quest 2.0/2.1 only )
  10.  
  11. 'By:            A.G. Bampton (originally 10/08/1999)   
  12.  
  13. 'Revision:    21/12/1999
  14.  
  15. 'Purpose/     See STDLIB.RTF for details of what this library does
  16. 'Usage:        and how to use it.
  17. '
  18. 'WARNING:    I STRONGLY ADVISE YOU NEVER CHANGE ANY CODE IN THIS
  19. '            LIBRARY! It's complete and functional 'as is' and if
  20. '            it has been altered I will not be able to offer any
  21. '            support for it's use. Tailor/modify the way it works
  22. '            in external code - either within your 'ASL' game code
  23. '            or, IF YOU ARE USING QUEST PRO AND CAN COMPILE YOUR
  24. '            GAME TO A 'CAS' FILE ONLY, by including a customising
  25. '            library as per 'library_demo.asl' my standard library
  26. '            demo. 
  27. '----------------------------------------------------------------------
  28.  
  29. !asl-version <200>
  30.  
  31. !addto game
  32.     command <look at #object#> do <Look_Proc>
  33.     command <x #object#> do <Look_Proc>
  34.     command <drop #object# in #container#> do <Put_In_Container_Proc>
  35.     command <drop #object# down> do <Drop_Proc>
  36.     command <drop #object#> do <Drop_Proc>
  37.     command <give #give_com_string#> do <Alternate_Give_Proc>
  38.     command <take #object# from #character#> do <Take_Back_Proc>
  39.     command <take #character#'s #object#> do <Take_Back_Proc>
  40.     command <take #character#s #object#> do <Take_Back_Proc>
  41.     command <take #character#' #object#> do <Take_Back_Proc>
  42.     command <take #object#> do <Special_Take_Proc>
  43.     command <customdrop #object# in #container#> do <Put_In_Container_Proc>
  44.     command <customdrop #object#> do <Drop_Proc>
  45.     command <customtake #object# from #character#> do <Take_Back_Proc>
  46.     command <customtake #object#> do <Special_Take_Proc>
  47. !end
  48.  
  49.  
  50. !addto synonyms
  51.     examine; inspect = look at
  52.     drop the; put the; put down the; put down; put = drop
  53.     give back the; give back; give the = give
  54.     get the; get; take back the; take back; take the = take
  55.     out of the; out of; back from the; back from; from the = from
  56.     in to; in to the; into the; into; inside the; inside = in
  57.     back to the; back to; to the = to 
  58. !end
  59.  
  60. '-------------------------------------------------------------------
  61.  
  62. 'The rest of this library is appended to the calling ASL file
  63.  
  64.  
  65. define procedure <Alternate_Give_Proc>
  66.     setvar <found_to;0>
  67.     for <to_true;1;$lengthof(#give_com_string#)$> do <to_test>
  68.         if not is <%found_to%;0> then {
  69.         exec <give #give_com_string#;normal>
  70.         setvar <found_to;0>
  71.         }
  72.         else {
  73.         for <space_true;1;$lengthof(#give_com_string#)$> do <space_test>
  74.         setstring <give_char;$left(#give_com_string#;%found_space%)$>
  75.         setstring <give_obj;$mid(#give_com_string#;%found_space%)$>
  76.         exec <give #give_obj# to #give_char#;normal>
  77.         }
  78. end define
  79.     
  80.  
  81. define procedure <to_test>
  82.     setstring <to_test_for;$mid(o to c;2;4)$>
  83.     setstring <test_part;$mid(#give_com_string#;%to_true%;4)$>
  84.     if is <#to_test_for#;#test_part#> then setvar <found_to;%to_true%>
  85. end define
  86.     
  87.  
  88. define procedure <space_test>
  89.     setstring <to_test_for;$mid(c o;2;1)$>
  90.     setstring <test_part;$mid(#give_com_string#;%space_true%;1)$>
  91.     if is <#to_test_for#;#test_part#> then setvar <found_space;%space_true%>
  92. end define
  93.  
  94.  
  95. define procedure <Look_Proc>
  96.  
  97. if not is <#standard.lib.version#;> then {
  98.  
  99.     if is <$instr(#standard.lib.characters#;#object#)$;0> then {
  100.     setstring <where_it_is;$locationof(#object#)$>
  101.  
  102.         if not is <$instr(#standard.lib.containers#;#where_it_is#)$;0> then {
  103.  
  104.             if not is <$instr(#standard.lib.characters#;#where_it_is#)$;0> then {
  105.  
  106.                 if here <#where_it_is#> then {
  107.                 moveobject <#object#;#quest.currentroom#>
  108.                 showobject <#object#>
  109.                 exec <look at #object#;normal>
  110.                 moveobject <#object#;#where_it_is#>
  111.                 }
  112.                 else {
  113.                 exec <look at #object#;normal>
  114.                 }
  115.  
  116.             }
  117.             else {
  118.  
  119.                 if here <#where_it_is#> or got <#where_it_is#> then {
  120.                 moveobject <#object#;#quest.currentroom#>
  121.                 showobject <#object#>
  122.                 exec <look at #object#;normal>
  123.                 moveobject <#object#;#where_it_is#>
  124.                 }
  125.                 else {
  126.                 exec <look at #object#;normal>
  127.                 }
  128.  
  129.             }
  130.  
  131.         }
  132.         else {
  133.  
  134.             if got <#object#> then {
  135.             moveobject <#object#;#quest.currentroom#>
  136.             showobject <#object#>
  137.             exec <look at #object#;normal>
  138.             do <Check_Contents_Proc>
  139.             hideobject <#object#>
  140.             moveobject <#object#;#where_it_is#>
  141.             }
  142.             else {
  143.             exec <look at #object#;normal>
  144.  
  145.                 if here <#object#> then {
  146.                 do <Check_Contents_Proc>
  147.                 }
  148.  
  149.             }    
  150.  
  151.         }
  152.  
  153.     }
  154.     else {
  155.     exec <look at #object#;normal>
  156.  
  157.         if here <#object#> then {
  158.         do <Check_Contents_Proc>
  159.         }
  160.     }
  161.  
  162. }
  163. else {
  164. do <Old_Look_Proc>
  165. }
  166.  
  167. end define
  168.  
  169. define procedure <Check_Contents_Proc>
  170.  
  171.         if not is <$instr(#standard.lib.containers#;#object#)$;0> then {
  172.         setstring <where_we_were;#quest.currentroom#>
  173.         outputoff
  174.         goto <#object#>
  175.             if is <$lengthof(#quest.objects#)$;0> then {
  176.             goto <#where_we_were#>
  177.             outputon
  178.             }
  179.             else {
  180.             setstring <parsed_list;$gettag(#object#;prefix)$ __
  181.             $parse_object_list$>
  182.             goto <#where_we_were#>
  183.             outputon
  184.             msg <#parsed_list#>
  185.             }
  186.         }
  187. end define
  188.  
  189. define function <parse_object_list>
  190.     setvar <found_comma;0>
  191.     for <last_comma;1;$lengthof(#quest.formatobjects#)$> {
  192.     do <Last_Comma_Proc>
  193.     }
  194.         if not is <%found_comma%;0> then { 
  195.         setvar <remaining;%last_comma%-%found_comma%>
  196.         setvar <remaining;%remaining%-1>
  197.         setvar <found_comma;%found_comma%-1>
  198.         setstring <left_part;$left(#quest.formatobjects#;__
  199.         %found_comma%)$>
  200.         setstring <right_part;$right(#quest.formatobjects#;__
  201.         %remaining%)$>
  202.         setstring <parsed_object_list;#left_part# and #right_part#.>
  203.         }
  204.         if is <%found_comma%;0> then {
  205.         setstring <parsed_object_list;#quest.formatobjects#.>
  206.         }
  207.         return <#parsed_object_list#>
  208. end define
  209.  
  210. define procedure <Last_Comma_Proc>
  211.     setstring <test_part;$mid(#quest.formatobjects#;%last_comma%;1)$>
  212.     if is <#test_part#;,> then setvar <found_comma;%last_comma%>
  213. end define
  214.  
  215.  
  216. define procedure <Drop_Proc>
  217.  
  218.     if is <$instr(#standard.lib.characters#;#object#)$;0> then {
  219.     do <override_permitted>  
  220.     if is <#override#;yes> then {
  221.  
  222.         if got <#object#> then {
  223.         lose <#object#>
  224.         moveobject <#object#;#quest.currentroom#>
  225.         showobject <#object#>
  226.         setvar <custom_message; $lengthof(#std.lib.message.drop#)$>
  227.             if is <%custom_message%; 0> then msg <You drop the #object#.>
  228.             else msg <#std.lib.message.drop#.>
  229.         }
  230.         else {
  231.         setvar <custom_message; $lengthof(#std.lib.message.notcarried#)$>
  232.             if is <%custom_message%; 0> then msg <You're not holding the #object#.>
  233.             else msg <#std.lib.message.notcarried#.>
  234.         }
  235.  
  236.     }
  237.     }
  238.     else msg <Sorry, I don't understand '#quest.originalcommand#'.>
  239. end define
  240.  
  241.  
  242. define procedure <Special_Take_Proc>
  243.  
  244. if not is <#standard.lib.version#;> then {
  245.  
  246.     if is <$instr(#standard.lib.characters#;#object#)$;0> then {
  247.     do <override_permitted>  
  248.         if is <#override#;yes> then {
  249.         setstring <where_it_is;$locationof(#object#)$>
  250.             if not is <$instr(#standard.lib.containers#;#where_it_is#)$;0> then {
  251.                 if not is <$instr(#standard.lib.characters#;#where_it_is#)$;0> then {
  252.                     if here <#where_it_is#> then {
  253.                     exec <take #object# from #where_it_is#>
  254.                     }
  255.                     else exec <take #object#;normal>
  256.                 }
  257.                 else {
  258.                     if here <#where_it_is#> or got <#where_it_is#> then {
  259.                     exec <take #object# from #where_it_is#>
  260.                     }
  261.                     else exec <take #object#;normal>
  262.                 }
  263.             }
  264.             else {
  265.                 if got <#object#> then {
  266.                 setvar <custom_message; $lengthof(#std.lib.message.alreadygot#)$>
  267.                     if is <%custom_message%; 0> then {
  268.                     msg <You already have it.>
  269.                     }
  270.                     else {
  271.                     msg <#std.lib.message.alreadygot#.>
  272.                     }
  273.                 }
  274.                 else {
  275.                     if here <#object#> then {
  276.                     exec <take #object#;normal>
  277.                     }
  278.                     else {
  279.                     exec <take #object#;normal>
  280.                     }
  281.                 }
  282.             }
  283.         }
  284.     }
  285.     else msg <Sorry, I don't understand '#quest.originalcommand#'.>
  286. }
  287. else {
  288. do <Old_Special_Take_Proc>
  289. }
  290. end define
  291.  
  292.  
  293. define procedure <Take_Back_Proc>
  294.  
  295. if not is <#standard.lib.version#;> then {
  296.  
  297.     if not is <$instr(#standard.lib.containers#;#character#)$;0> then {
  298.     if is <$instr(#standard.lib.characters#;#character#)$;0> then {
  299.     setstring <container;#character#>
  300.     }
  301.     else {
  302.     setstring <container;#object#>
  303.     }
  304.     do <override_permitted>  
  305.     if is <#override#;yes> then {
  306.  
  307.     if here <#character#> or got <#container#> then {
  308.         if is <$locationof(#object#)$;#character#> then {
  309.         moveobject <#object#;#quest.currentroom#>
  310.         give <#object#>
  311.         hideobject <#object#>
  312.         setvar <custom_message; $lengthof(#std.lib.message.takefrom#)$>
  313.             if is <%custom_message%; 0> then {
  314.                 if is <$gettag(#character#;look)$;character> then {
  315.                 msg <You reach out and take the #object# from $capfirst(#character#)$.> }
  316.                 else msg <You take the #object# out of the #character#.> 
  317.             }
  318.             else msg <#std.lib.message.takefrom#.>
  319.         }
  320.         else {
  321.             setvar <custom_message; $lengthof(#std.lib.message.objnotheld#)$>
  322.             if is <%custom_message%;0> then {
  323.                 if is <$gettag(#character#;look)$;character> then {
  324.                 msg <You can't do that, $capfirst(#character#)$ doesn't have the #object#.> }
  325.                 else msg <You can't do that, the #object# isn't in the #character#.>
  326.             }
  327.             else msg <#std.lib.message.objnotheld#.>
  328.         }
  329.     }
  330.     else {
  331.     setvar <custom_message; $lengthof(#std.lib.message.charnothere#)$>
  332.         if is <%custom_message%; 0> then {
  333.             if is <$gettag(#character#;look)$;character> then {
  334.             msg <You can't do that, $capfirst(#character#)$ isn't here.> }
  335.             else msg <You can't do that, the #character# isn't here.>
  336.         }
  337.         else msg <#std.lib.message.charnothere#.>
  338.     }
  339.  
  340.     }
  341.     }
  342.     else msg <Sorry, I don't understand '#quest.originalcommand#'.>
  343. }
  344. else {
  345. do <Old_Take_Back_Proc>
  346. }
  347. end define
  348.  
  349.  
  350. define procedure <Put_In_Container_Proc>
  351.     do <override_permitted>  
  352.     if is <#override#;yes> then {
  353.  
  354.     if is <#object#;#container#> then do <Put_In_Self_Proc>
  355.     else {
  356.     setstring <test_prefix;$gettag(#container#;prefix)$>
  357.         if is <$lengthof(#test_prefix#)$;0> then do <Not_A_Container_Proc>
  358.         else do <Put_In_Container_Verified_Proc>
  359.     }
  360.  
  361.     }
  362.     else msg <Sorry, I don't understand '#quest.originalcommand#'.>
  363. end define
  364.  
  365.  
  366. define procedure <Not_A_Container_Proc>
  367.     setvar <custom_message; $lengthof(#std.lib.message.notacontainer#)$>
  368.         if is <%custom_message%; 0> then msg <It's not possible to do that.>
  369.         else msg <#std.library.message.notacontainer#.>                    
  370. end define
  371.  
  372.  
  373. define procedure <Put_In_Self_Proc>
  374.     setvar <custom_message; $lengthof(#std.lib.message.putinself#)$>
  375.         if is <%custom_message%; 0> then msg <That would be some feat if you could manage it!>
  376.         else msg <#std.library.message.putinself#.>                    
  377. end define
  378.  
  379. define procedure <Put_In_Container_Verified_Proc>
  380.     if is <$gettag(#container#;look)$;character> then {
  381.     msg <( assuming you meant "|iGive #object# to $capfirst(#container#)$"|xi. )>
  382.     exec <give #object# to #container#>
  383.     }
  384.     else if is <$gettag(#object#;look)$;character> and here <#object#> then do <Put_Char_In_Obj_Proc>
  385.     else if is <$gettag(#object#;look)$;character> then do <Character_Not_Here_Proc>
  386.     else {
  387.     if got <#object#> and got <#container#> then do <Put_It_In_Proc>
  388.         else {
  389.             if got <#object#> and here <#container#> then do <Put_It_In_Proc>
  390.             else {
  391.                 if got <#object#> then do <No_Container_Here_Proc>
  392.                 else {
  393.                 do <Nothing_To_Put_In_Proc>
  394.                 }
  395.             }
  396.         }
  397.     }
  398. end define
  399.  
  400.  
  401. define procedure <Put_Char_In_Obj_Proc>
  402.     setvar <custom_message; $lengthof(#std.lib.message.putcharinobj#)$>
  403.         if is <%custom_message%; 0> then msg <You can't do that with $capfirst(#object#)$.>
  404.         else msg <#std.lib.message.putcharinobj#.> 
  405. end define
  406.  
  407.  
  408. define procedure <No_Container_Here_Proc>
  409.     setvar <custom_message; $lengthof(#std.lib.message.nocontainerhere#)$>
  410.         if is <%custom_message%; 0> then msg <The #container# isn't available for you __
  411.         to put things in at the moment.>
  412.         else msg <#std.library.message.nocontainerhere#.>                    
  413. end define
  414.  
  415.  
  416. define procedure <Character_Not_Here_Proc>
  417.     setvar <custom_message; $lengthof(#std.lib.message.charnothere#)$>
  418.         if is <%custom_message%; 0> then msg <$capfirst(#object#)$ isn't here.>
  419.         else msg <#std.lib.message.charnothere#.>
  420. end define
  421.  
  422.  
  423. define procedure <Nothing_To_Put_In_Proc>
  424.     setvar <custom_message; $lengthof(#std.lib.message.nothingtoputin#)$>
  425.         if is <%custom_message%; 0> then msg <You don't appear to be holding the #object#.>
  426.         else msg <#std.lib.message.nothingtoputin#.>
  427. end define
  428.  
  429.  
  430. define procedure <Put_It_In_Proc>
  431.     lose <#object#>
  432.     moveobject <#object#;#container#>
  433.     showobject <#object#@#container#>
  434.     setvar <custom_message; $lengthof(#std.lib.message.putincontainer#)$>
  435.         if is <%custom_message%; 0> then msg <You put the #object# into the #container#.> 
  436.         else msg <#std.lib.message.putincontainer#.>
  437. end define
  438.  
  439.  
  440. define procedure <override_permitted>
  441.     setstring <override;#reset#>
  442.     if is <$left(#quest.command#;6)$;custom> then {
  443.         if is <#std.lib.override#;yes> then {
  444.         setstring <std.lib.override;#reset#>
  445.         setstring <override;yes>
  446.         }
  447.         else {
  448.         setstring <override;#reset#>    
  449.         }
  450.     }
  451.     else setstring <override;yes>
  452. end define
  453.  
  454. define procedure <standard_lib_setup>
  455.     setstring <reset;>
  456.     setstring <std.lib.message.override;>
  457.     setstring <std.lib.message.drop;>
  458.     setstring <std.lib.message.notcarried;>
  459.     setstring <std.lib.message.alreadygot;>
  460.     setstring <std.lib.message.takefrom;>
  461.     setstring <std.lib.message.objnotheld;>
  462.     setstring <std.lib.message.charnothere;>
  463.     setstring <std.lib.message.nocontainerhere;>
  464.     setstring <std.lib.message.notacontainer;>
  465.     setstring <std.lib.message.putincontainer;>
  466.     setstring <std.lib.message.nothingtoputin;>
  467.     setstring <std.lib.message.putcharinobj;>
  468.     setstring <std.lib.message.putinself;>
  469. end define
  470.  
  471.  
  472. '==== Following code included for backward compatibility only ====
  473.  
  474. define procedure <Old_Look_Proc>
  475.     if got <#object#> then {
  476.     moveobject <#object#;#quest.currentroom#>
  477.     showobject <#object#>
  478.     exec <look at #object#;normal>
  479.     do <Old_Contents_Proc>
  480.     hideobject <#object#>
  481.     }
  482.     else {
  483.     setstring <where_it_is;$locationof(#object#)$>
  484.         
  485.     if here <#where_it_is#> or got <#where_it_is#> then {
  486.         moveobject <#object#;#quest.currentroom#>
  487.         showobject <#object#>
  488.         exec <look at #object#;normal>
  489.         moveobject <#object#;#where_it_is#>
  490.         do <Old_Contents_Proc>
  491.         }
  492.         else {
  493.         exec <look at #object#;normal>
  494.         do <Old_Contents_Proc>
  495.         }
  496.     }
  497. end define
  498.  
  499.  
  500. define procedure <Old_Contents_Proc>
  501.     if is <$locationof(#object#)$;#quest.currentroom#> or got <#object#> then {
  502.     setstring <Where_We_Were;#quest.currentroom#>
  503.     outputoff
  504.     goto <#object#>
  505.         if is <$lengthof(#quest.objects#)$;0> then {
  506.         goto <#Where_We_Were#>
  507.         outputon
  508.         }
  509.         else {
  510.         outputon
  511.         msg <$gettag(#object#;prefix)$ #quest.formatobjects#.>
  512.         outputoff
  513.         goto <#Where_We_Were#>
  514.         outputon
  515.         }
  516.     }
  517. end define
  518.  
  519. define procedure <Old_Special_Take_Proc>
  520.     do <override_permitted>  
  521.     if is <#override#;yes> then {
  522.  
  523.     setstring <where_it_is;$locationof(#object#)$>
  524.     if here <#where_it_is#> or got <#where_it_is#> then exec <take #object# from #where_it_is#>
  525.     else {
  526.         if got <#object#> then {
  527.         setvar <custom_message; $lengthof(#std.lib.message.alreadygot#)$>
  528.             if is <%custom_message%; 0> then msg <You already have it.>
  529.             else msg <#std.lib.message.alreadygot#.>
  530.         }
  531.         else exec <take #object#;normal>
  532.     }
  533.  
  534.     }
  535.     else msg <Sorry, I don't understand '#quest.originalcommand#'.>
  536. end define
  537.  
  538.  
  539. define procedure <Old_Take_Back_Proc>
  540.     do <override_permitted>  
  541.     if is <#override#;yes> then {
  542.  
  543.     if here <#character#> or got <#character#> then {
  544.         if is <$locationof(#object#)$;#character#> then {
  545.         moveobject <#object#;#quest.currentroom#>
  546.         give <#object#>
  547.         hideobject <#object#>
  548.         setvar <custom_message; $lengthof(#std.lib.message.takefrom#)$>
  549.             if is <%custom_message%; 0> then {
  550.                 if is <$gettag(#character#;look)$;character> then {
  551.                 msg <You reach out and take the #object# from $capfirst(#character#)$.> }
  552.                 else msg <You take the #object# out of the #character#.> 
  553.             }
  554.             else msg <#std.lib.message.takefrom#.>
  555.         }
  556.         else {
  557.             setvar <custom_message; $lengthof(#std.lib.message.objnotheld#)$>
  558.             if is <%custom_message%;0> then {
  559.                 if is <$gettag(#character#;look)$;character> then {
  560.                 msg <You can't do that, $capfirst(#character#)$ doesn't have the #object#.> }
  561.                 else msg <You can't do that, the #object# isn't in the #character#.>
  562.             }
  563.             else msg <#std.lib.message.objnotheld#.>
  564.         }
  565.     }
  566.     else {
  567.     setvar <custom_message; $lengthof(#std.lib.message.charnothere#)$>
  568.         if is <%custom_message%; 0> then {
  569.             if is <$gettag(#character#;look)$;character> then {
  570.             msg <You can't do that, $capfirst(#character#)$ isn't here.> }
  571.             else msg <You can't do that, the #character# isn't here.>
  572.         }
  573.         else msg <#std.lib.message.charnothere#.>
  574.     }
  575.  
  576.     }
  577.     else msg <Sorry, I don't understand '#quest.originalcommand#'.>
  578. end define
  579.